---
title: "Report"
date: "`r Sys.Date()`"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    social: menu
    source_code: embed
---

```{r setup, include=FALSE, cache=TRUE}
## Global options
library(reticulate)
library(knitr)
library(flexdashboard)
library(scales)
library(here)
library(tidyverse)
library(readr)
library(plotly)
library(tidyverse)
knitr::opts_chunk$set(cache = TRUE)
source(here('modules','data_funcs.R'))

# PARAMS
warm <- 250
dur <- 1000
repl <- 30
path <- here('data','full-sm')



# NO CUU - OR * 1
modif <- '0-1'
dt_pl_n10 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_n10 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_n10 <- generate_summary_zs(path, modif, FALSE)

# # NO CUU - OR * 1.1
# modif <- '0-1.1'
# dt_pl_n11 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_n11 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_n11 <- generate_summary_zs(path, modif, FALSE)
# 
# # NO CUU - OR * 1.2
# modif <- '0-1.2'
# dt_pl_n12 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_n12 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_n12 <- generate_summary_zs(path, modif, FALSE)
# 
# # NO CUU - OR * 1.3
# modif <- '0-1.3'
# dt_pl_n13 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_n13 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_n13 <- generate_summary_zs(path, modif, FALSE)
# 
# 
# 
# # CUU - OR * 1
# modif <- '1000-1'
# dt_pl_y10 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_y10 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_y10 <- generate_summary_zs(path, modif, TRUE)
# 
# # CUU - OR * 1.1
# modif <- '1000-1.1'
# dt_pl_y11 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_y11 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_y11 <- generate_summary_zs(path, modif, TRUE)
# 
# # CUU - OR * 1.2
# modif <- '1000-1.2'
# dt_pl_y12 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_y12 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_y12 <- generate_summary_zs(path, modif, TRUE)
# 
# # CUU - OR * 1.3
# modif <- '1000-1.3'
# dt_pl_y13 <- generate_summary(path, modif, dur, warm, repl)
# dt_sa_y13 <- generate_summary_sa(path, modif, dur, warm, repl)
# dt_zs_y13 <- generate_summary_zs(path, modif, TRUE)


# MODEL DATA SUMMARY
arrival_rate <- data.frame(
  Surgery = c('Surgery 1', 'Surgery 1', 'Surgery 4', 
              'Surgery 4', 'Surgery 6', 'Surgery 6'),
  Complexity = c('Complexity 1', 'Complexity 2', 'Complexity 1', 
                 'Complexity 2', 'Complexity 1', 'Complexity 2'),
  "Arrival_Adjusted" = c(1.23, 0.62, 0.14, 0.10, 1.23, 0.62),
  "Arrival_Original" = c(1, 0.5, 0.0833, 0.0625, 1, 0.5), 
  Rationale = c("once per week", "once per two weeks", "once per 3 months", 
                "once per 4 months", "once per week", "once per 2 weeks")
)

resource_usage <- data.frame(
  Surgery = c('Surgery 1', 'Surgery 1', 'Surgery 1', 'Surgery 1', 
              'Surgery 4', 'Surgery 4', 'Surgery 4', 'Surgery 4', 
              'Surgery 6', 'Surgery 6', 'Surgery 6', 'Surgery 6'),
  Complexity = c('Complexity 1', 'Complexity 1', 'Complexity 2', 
                 'Complexity 2', 'Complexity 1', 'Complexity 1', 
                 'Complexity 2', 'Complexity 2', 'Complexity 1', 
                 'Complexity 1', 'Complexity 2', 'Complexity 2'),
  Resource_Type = c('Admissions', 'OR_Time','Admissions', 'OR_Time',
                    'Admissions', 'OR_Time','Admissions', 'OR_Time',
                    'Admissions', 'OR_Time','Admissions', 'OR_Time'), 
  Usage = c(0,3,1,4,1,4,1,5.5,0,1.5,0,2.5)
)

resource_capacity <- data.frame(
  Resouce = c('Admissions', 'OR_Time'),
  Capacity_Weekly = c(1.5, 11.25),
  Unit = c("Patients Admitted per week", "OR Hours per week")
)
```

Model Parameters
=======================================================================

Row
-----------------------------------------------------------------------

### Model Parameters
**Model Instance**

* Planning horizon is decreased from 24 weeks to 10 weeks
* Maximum tracked wait is decreased from 6 weeks to 4 weeks
* There are 3 surgeries instead of 6 surgeries
* Number of priorities is set to 1

**Simulation Parameters**

* 30 Replications
* 1000 weeks duration
* 250 weeks warm up

**Surgeries**

* Surgery 1 - 1. SPINE POSTERIOR DECOMPRESSION/LAMINECTOMY LUMBAR
* Surgery 4 - 4. SPINE POST CERV DECOMPRESSION AND FUSION W INSTR
* Surgery 6 - 6. SPINE POSTERIOR DISCECTOMY LUMBAR

### Arrival Rate
It was set to be 95% of the capacity, however due to transitions, the resource usage should be higher than 95%
``` {r echo=FALSE, cache=FALSE}
kable(arrival_rate)
```

Row
-----------------------------------------------------------------------

### Resource Usage
```{r echo=FALSE, cache=FALSE}
kable(resource_usage)
```

### Resource Capacity
```{r echo=FALSE, cache=FALSE}
kable(resource_capacity)
```



nPen, OR*1
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

```{r echo=FALSE}
dt_zs_n10$zf_plt %>% ggplotly()
```

### Policy Description



nPen, OR*1.1
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



nPen, OR*1.2
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



nPen, OR*1.3
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description






Pen, OR*1
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



Pen, OR*1.1
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



Pen, OR*1.2
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



Pen, OR*1.3
=======================================================================

Row
-----------------------------------------------------------------------

### Policy Graph

### Policy Description



<!-- # R1R2 Report -->
<!-- This model is the default model that does not penalize bed under utilization -->

<!-- ## Policy Description -->
<!-- The description will be based on the following graphs (both of them are for M of 0 only): -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2_policy -->
<!-- ``` -->

<!-- The top graphs show MDP policy, and the graphs below show Myopic policy. -->

<!-- The graph on the left shows in which days the policy will allow scheduling. If the value is below 0 - the model will allow scheduling, otherwise the model will keep patients in the waitlist. Thus this policy **will only schedule into week 1 and week 2**. The plot on the right shows the approximate priority of different surgeries. The lower the surgery is on the list the more likely it is to be scheduled first. The following is the order: -->

<!-- - Surgery 6, Complexity 2 -->
<!-- - Surgery 6, Complexity 1 -->
<!-- - Surgery 1, Complexity 1 -->
<!-- - Surgery 1, Complexity 2 -->
<!-- - Surgery 4, Complexity 1 -->
<!-- - Surgery 4, Complexity 2 -->

<!-- For Myopic, it is changed such that the entire horizon is filled. And the graph on the right shows the approximate order of scheduling priority. It appears to be very similar to MDP. -->

<!-- Additionally the following graphs give some insights on how the policy makes decision -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2_sa$res_plot$sched_plt -->
<!-- ``` -->

<!-- ## Policy Results -->
<!-- ### Wait Times in weeks -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2$results$pw) -->
<!-- ``` -->

<!-- ### Wait List Size -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2$results$wtl) -->
<!-- ``` -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2_sa$res_plot$waitlist_plt -->
<!-- ``` -->

<!-- ### Utilization -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2$results$util) -->
<!-- ``` -->

<!-- ### Reschedules as percentage of arrivals & Total Reschedules -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2$results$rsc) -->
<!-- ``` -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2_sa$res_plot$rsc_plt %>% ggplotly() -->
<!-- ``` -->

<!-- ### Transitions per week -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2$results$tr) -->
<!-- ``` -->



<!-- # R1R2R3 Report -->
<!-- In addition to the parameters above, this model penalizes bed under utilization in the first period -->

<!-- ## Policy Description -->
<!-- <!-- The description will be based on the following graphs: --> -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2R3_policy -->
<!-- ``` -->

<!-- Additionally the following graphs give some insights on how the policy makes decision -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2R3_sa$res_plot$sched_plt -->
<!-- ``` -->

<!-- ## Policy Results -->

<!-- ### Wait Times in weeks -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2R3$results$pw) -->
<!-- ``` -->

<!-- ### Wait List Size -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2R3$results$wtl) -->
<!-- ``` -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2R3_sa$res_plot$waitlist_plt -->
<!-- ``` -->

<!-- ### Utilization -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2R3$results$util) -->
<!-- ``` -->

<!-- ### Reschedules as percentage of arrivals & Total Reschedules -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2R3$results$rsc) -->
<!-- ``` -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- R1R2R3_sa$res_plot$rsc_plt %>% ggplotly() -->
<!-- ``` -->

<!-- ### Transitions per week -->
<!-- ```{r echo=FALSE, cache=FALSE} -->
<!-- kable(R1R2R3$results$tr) -->
<!-- ``` -->